home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / CGI shell / length.4th < prev    next >
Text File  |  1995-10-30  |  2KB  |  101 lines
  1. \
  2. \ Physics Units Conversions  -  Length
  3. \
  4. \ Ronald T. Kneusel, rkneusel@post.its.mcw.edu, 27-Oct-95
  5. \
  6. \ Last mod: 30-Oct-95
  7. \
  8. \
  9. \ All conversions are a table lookup.  The calculation is:
  10. \
  11. \   dest value =  (array[dest]/array[source]) * source value
  12. \
  13. \ where array[dest] returns the address of a floating point
  14. \ constant for that conversion
  15. \
  16.  
  17. ( load CGIshell, template code )
  18.  
  19. --> CGIshell.4th
  20. --> template.4th
  21.  
  22. ( strings and such )
  23.  
  24. $[ fname length.txt]    \ template filename
  25.  
  26. message[ src source]   \ field names
  27. message[ dst dest]
  28. message[ val value]
  29.  
  30. 2048 String>> out      \ output string
  31. 30 String>> ans        \ answer goes here
  32. 30 String>> org        \ initial value
  33. 30 String>> s          \ scratch
  34.  
  35. 2 array>> A  ans 0 A !array  \ setup answer
  36. org 1 A !array
  37.  
  38. ( use template's array words for the conversion array )
  39.  
  40. 15 array>> ang
  41.  
  42. ( length constants )
  43.  
  44. : >ang ( v indx -- )  ang !array ;
  45.  
  46. fvariable &0  fvariable &1  fvariable &2  fvariable &3 
  47. fvariable &4  fvariable &5  fvariable &6 
  48. fvariable &7  fvariable &8  fvariable &9  fvariable &10 
  49. fvariable &11  fvariable &12  fvariable &13 
  50.  
  51. &0 0 >ang &1 1 >ang &2 2 >ang &3 3 >ang &4 4 >ang &5 5 >ang 
  52. &6 6 >ang &7 7 >ang &8 8 >ang &9 9 >ang &10 10 >ang 
  53. &11 11 >ang &12 12 >ang &13 13 >ang 
  54.  
  55. ( other variables )
  56.  
  57. fvariable x  fvariable y    \ value and answer
  58. variable i  variable j
  59.  
  60. ( setup array values )
  61.  
  62. 1.0 &0 f!  1.0e10 &1 f!   6.685e-12 &2 f!   100.0 &3 f!
  63. 1.0e15 &4 f!  3.281 &5 f!  39.37 &6 f!  1.0e-3 &7 f!
  64. 1.057e-16 &8 f!  1.0e6 &9 f!  5.400e-4 &10 f!  6.214e-4 &12 f!
  65. 3.241e-17 &11 f!  1.094 &13 f!
  66.  
  67. ( do the conversion )
  68.  
  69. : calc ( -- )  \ calculate
  70.    j @ ang @array f@  i @ ang @array f@  f/   \  array[dest]/array[source]
  71.    x f@ f*  y f!
  72. ;
  73.  
  74. : f< ( f1 f2 -- f1<f2 ) fcompare >r fdrop fdrop r> -1 = ;
  75. : f> ( f1 f2 -- f1>f2 ) fcompare >r fdrop fdrop r>  1 = ;
  76. : pp ( -- )  \ set the output number format
  77.    y f@ fabs fdup
  78.    0.009 f> >r  100000.0 f< r> and
  79.    IF  6 fix  ELSE  6 sci  THEN ;
  80.  
  81. ( Apple Event handler )
  82.  
  83. ,s sdoc  ,s WWWΩ  ae:
  84.  
  85.    s src NEW @Field  s str>f f>d drop i !  \ conversion type
  86.    s dst NEW @Field  s str>f f>d drop j !
  87.    
  88.    org val NEW @Field  org str>f x f!      \ value to convert
  89.    
  90.    calc                                    \ calculate answer
  91.    
  92.    pp y f@ ans f>str                       \ answer into string
  93.    
  94.    out A fname NEW template                \ build reply
  95.    
  96.    out REPLY                               \ send reply
  97.    bye
  98.    
  99. ;ae
  100.  
  101.